00100	
00200		REQUIRE "GEOMED.REL[SAI,BGB]"	LOAD_MODULE;
00300		REQUIRE "GEOMES.REL[SAI,BGB]"	LOAD_MODULE;
00400		REQUIRE "UTILTY.REL[SAI,BGB]"	LOAD_MODULE;
00500		REQUIRE "EULER.REL[SAI,BGB]"	LOAD_MODULE;
00600		REQUIRE "EUCLID.REL[SAI,BGB]"	LOAD_MODULE;
00700		REQUIRE "OCCULT.REL[SAI,BGB]"	LOAD_MODULE;
00800		REQUIRE "BIN.REL[SAI,BGB]"	LOAD_MODULE;
00900	
01000		REQUIRE "⊂⊃⊂⊃" DELIMITERS;
01100		DEFINE $UBR=⊂EXTERNAL SIMPLE INTEGER PROCEDURE⊃;
01200	
01300	COMMENT BASIC GEOMED, IO AND DISPLAY;
01400		EXTERNAL INTEGER UNIVERSE;
01500		INTERNAL INTEGER RESULT;
01600	
01700		$UBR MKUNIV;
01800		$UBR GEOMED;
01900		$UBR GEODPY;
02000	
02100		$UBR SHOW1(INTEGER WINDOW,GLASS);
02200		$UBR SHOW2(INTEGER WINDOW,GLASS);
02300		$UBR SHOW3(INTEGER WINDOW,GLASS);
02400	
02500		$UBR PPROJ(INTEGER CAMERA,WORLD);
02600	
02700		$UBR INGEM(STRING FILNAM);
02800		$UBR INB3D(STRING FILNAM);
02900		$UBR INCAM(STRING FILNAM);
03000		$UBR SETFOC(REAL FMM);
03100	
03200		$UBR FDNAME(STRING FILNAM);
03300		$UBR OUTGEM(STRING FILNAM;INTEGER B);
03400		$UBR OUTB3D(STRING FILNAM;INTEGER B);
03500		$UBR OUTCAM(STRING FILNAM);
03600		$UBR PLOTO(STRING FILNAM);
03700	
     

00100	COMMENT EUCLID;
00200		$UBR APTRAM(INTEGER Q,ET);
00250		$UBR APTRAN(INTEGER Q,ET);
00300		$UBR INTRAM(INTEGER ET);
00350		$UBR INTRAN(INTEGER ET);
00400		$UBR TRANSL(INTEGER Q;REAL X,Y,Z);
00500		$UBR ROTATE(INTEGER Q;REAL X,Y,Z);
00600		$UBR SHRINK(INTEGER Q;REAL X,Y,Z);
00700	
00800		$UBR MKTRMA(REAL P,T,S);
00900		$UBR MKTRMF(INTEGER F);
01000		$UBR MKTRMV(REAL WX,WY,WZ);
01100		$UBR MKROTV(INTEGER TRAM);
01150		$UBR CVTRMV(INTEGER TRAM);
01200		$UBR MKTRAM;
01300	
01400		EXTERNAL SIMPLE REAL PROCEDURE DISTAN(INTEGER Q1,Q2);
01500		EXTERNAL SIMPLE REAL PROCEDURE DETERM(INTEGER Q);
01600	
     

00100	COMMENT WINGED EDGE PRIMITIVES;
00200		$UBR MKNODE(INTEGER TYP);	$UBR KLNODE(INTEGER NODE);
00300		$UBR MKCAMERA(INTEGER WORLD);	$UBR MKWORLD;
00400		$UBR MKWINDOW(INTEGER CAMERA,WINDOW);
00500		$UBR MKB(INTEGER WORLD);	$UBR KLB(INTEGER BNEW);
00600		$UBR KLBFEV(INTEGER BNEW);	$UBR MKBFV;
00700		$UBR KILL(INTEGER BNEW);
00800		$UBR MKF(INTEGER FNEW);		$UBR KLF(INTEGER FNEW);
00900		$UBR MKE(INTEGER ENEW);		$UBR KLE(INTEGER ENEW);
01000		$UBR MKV(INTEGER VNEW);		$UBR KLV(INTEGER VNEW);
01100		$UBR WING(INTEGER E1,E2);	$UBR LINKED(INTEGER Q1,Q2);
01200		$UBR ECW(INTEGER Q1,Q2);	$UBR ECCW(INTEGER Q1,Q2);
01300		$UBR OTHER(INTEGER Q1,Q2);	$UBR BGET(INTEGER Q);
01400		$UBR VCW(INTEGER E,F);		$UBR VCCW(INTEGER E,F);
01500		$UBR FCW(INTEGER E,V);		$UBR FCCW(INTEGER E,V);
01600		$UBR BDET(INTEGER Q);		$UBR BATT(INTEGER Q1,Q2);
01700	
     

00100	COMMENT EULER PRIMITIVES;
00200		$UBR INVERT(INTEGER E);		$UBR EVERT(INTEGER B);
00300		$UBR MKEV(INTEGER F,V);		$UBR MKFE(INTEGER V1,F,V2);
00400		$UBR ESPLIT(INTEGER E);
00500		
00600		$UBR KLFE(INTEGER E);
00700		$UBR KLEV(INTEGER V);
00800		$UBR KLVE(INTEGER E);
00900	
01000		$UBR MKCOPY(INTEGER B);
01100		$UBR GLUE(INTEGER F1,F2);
01200		$UBR GLUEE(INTEGER F1,V1,F2,V2);
01300	
01400		$UBR SWEEP(INTEGER F,FLG);
01500		$UBR ROTCOM(INTEGER F);
01600		$UBR PYRAMID(INTEGER FV);
01700	
01800		$UBR REMOVF(INTEGER F);
01900		$UBR FVDUAL(INTEGER B);
02000	
02100		$UBR MKCUBE(REAL A,B,C);
02200		$UBR MKCYLN(REAL R,N,Z);
02300		$UBR MKBALL(REAL R,M,N);
02400	
02500		$UBR BUN(INTEGER B1,B2);
02600		$UBR BIN(INTEGER B1,B2);
02700		$UBR BSUB(INTEGER B1,B2);
02800	
     

00100	COMMENT EXTERNAL DECLARATIONS FOR DISPLAY ROUTINES;
00200	
00300		$UBR DPYSET(INTEGER ARRAY PTR);
00400		$UBR DPYBIG(INTEGER SIZE);
00500		$UBR DPYBRT(INTEGER SIZE);
00600	
00700		$UBR AVECT(INTEGER X,Y);
00800		$UBR AIVECT(INTEGER X,Y);
00900		$UBR RVECT(INTEGER X,Y);
01000		$UBR RIVECT(INTEGER X,Y);
01100	
01200		$UBR DPYSST(STRING S);
01300		$UBR DPYOUT(INTEGER POG);
01400		$UBR DPYSTR(REFERENCE INTEGER TEXT);
01500	
01600		$UBR DTYO(INTEGER BPTR);
01700		$UBR OCTDPY(INTEGER X);
01800		$UBR DECDPY(INTEGER X);
01900		$UBR FLODPY(REAL X;INTEGER PLACES(4));
02000	
     

00100	COMMENT GEM-NODE NAMES FOR LINKS AND DATA;
00200		$UBR CAR(INTEGER Q);
00300		$UBR CDR(INTEGER Q);
00400		$UBR DIP(INTEGER AC,Q);
00500		$UBR DAP(INTEGER AC,Q);
00600	
00700	SIMPLE INTEGER PROCEDURE XWD(INTEGER Q1,Q2);START_CODE HRLZ 1,Q1;HRR 1,Q2;END;
00750	SIMPLE INTEGER PROCEDURE MVNUM$(INTEGER A,Q);START_CODE MOVE 1,A;MOVEM 1,Q;END;
00800	
00900	COMMENT WORLD LOCUS;
01000		DEFINE XWC(V)=⊂MEMORY[V-3,REAL]⊃;
01100		DEFINE YWC(V)=⊂MEMORY[V-2,REAL]⊃;
01200		DEFINE ZWC(V)=⊂MEMORY[V-1,REAL]⊃;
01300		DEFINE AA(V)=⊂MEMORY[V-3,REAL]⊃;
01400		DEFINE BB(V)=⊂MEMORY[V-2,REAL]⊃;
01500		DEFINE CC(V)=⊂MEMORY[V-1,REAL]⊃;
01600		DEFINE BBIT=⊂'1000000⊃;
01700	
01800	COMMENT ROTATION MATRIX;
01900		DEFINE IX(V)=⊂MEMORY[V+0,REAL]⊃;
02000		DEFINE IY(V)=⊂MEMORY[V+1,REAL]⊃;
02100		DEFINE IZ(V)=⊂MEMORY[V+2,REAL]⊃;
02200		DEFINE JX(V)=⊂MEMORY[V+3,REAL]⊃;
02300		DEFINE JY(V)=⊂MEMORY[V+4,REAL]⊃;
02400		DEFINE JZ(V)=⊂MEMORY[V+5,REAL]⊃;
02500		DEFINE KX(V)=⊂MEMORY[V+6,REAL]⊃;
02600		DEFINE KY(V)=⊂MEMORY[V+7,REAL]⊃;
02700		DEFINE KZ(V)=⊂MEMORY[V+8,REAL]⊃;
02800	
02900	COMMENT PERSPECTIVE-PROJECTED LOCUS;
03000		DEFINE XPP(V)=⊂MEMORY[V+4,REAL]⊃;
03100		DEFINE YPP(V)=⊂MEMORY[V+5,REAL]⊃;
03200		DEFINE ZPP(V)=⊂MEMORY[V+6,REAL]⊃;
03300	
03400		DEFINE FOCAL(V)=⊂MEMORY[V+5,REAL]⊃;
03500		DEFINE SNUM(V)=⊂MEMORY[V]⊃;
03600		DEFINE MVNUM(V)=⊂MEMORY[V+4]⊃;
     

00100	
00200	DEFINE NFACE(Q)=⊂CAR((Q)+1)⊃;	DEFINE PFACE(Q)=⊂CDR((Q)+1)⊃;
00300	DEFINE NED(Q)=⊂CAR((Q)+2)⊃;	DEFINE PED(Q)=⊂CDR((Q)+2)⊃;
00400	DEFINE NVT(Q)=⊂CAR((Q)+3)⊃;	DEFINE PVT(Q)=⊂CDR((Q)+3)⊃;
00500	DEFINE NCW(Q)=⊂CAR((Q)+4)⊃;	DEFINE PCW(Q)=⊂CDR((Q)+4)⊃;
00600	DEFINE NCCW(Q)=⊂CAR((Q)+5)⊃;	DEFINE PCCW(Q)=⊂CDR((Q)+5)⊃;
00700	
00800	DEFINE DAD(Q)=⊂CAR((Q)+4)⊃;	DEFINE SON(Q)=⊂CDR((Q)+4)⊃;
00900	DEFINE BRO(Q)=⊂CAR((Q)+5)⊃;	DEFINE SIS(Q)=⊂CDR((Q)+5)⊃;
01000	
01100	DEFINE ALT(Q)=⊂CAR((Q)+6)⊃;	DEFINE ALT2(Q)=⊂CDR((Q)+6)⊃;
01200	DEFINE TRAM(Q)=⊂CDR(((Q))+6)⊃;
01300	DEFINE CW(Q)=⊂CAR((Q)+7)⊃;	DEFINE CCW(Q)=⊂CDR((Q)+7)⊃;
01400	
01500	DEFINE NLINK(Q)=⊂CAR((Q)+8)⊃;	DEFINE PLINK(Q)=⊂CDR((Q)+8)⊃;
01600	
01700	DEFINE NFACE$(A,Q)=⊂DIP((A),(Q)+1)⊃;	DEFINE PFACE$(A,Q)=⊂DAP((A),(Q)+1)⊃;
01800	DEFINE NED$(A,Q)=⊂DIP((A),(Q)+2)⊃;	DEFINE PED$(A,Q)=⊂DAP((A),(Q)+2)⊃;
01900	DEFINE NVT$(A,Q)=⊂DIP((A),(Q)+3)⊃;	DEFINE PVT$(A,Q)=⊂DAP((A),(Q)+3)⊃;
01950	DEFINE DAD$(A,Q)=⊂DIP((A),(Q)+4)⊃;
02000	DEFINE NLINK$(A,Q)=⊂DIP((A),(Q)+8)⊃;	DEFINE PLINK$(A,Q)=⊂DAP((A),(Q)+8)⊃;
02100	
02120	DEFINE TRAM$(A,Q)=⊂DAP((A),(Q)+6)⊃;
02160	DEFINE CW$(A,Q)=⊂DIP((A),(Q)+7)⊃;	DEFINE CCW$(A,Q)=⊂DAP((A),(Q)+7)⊃;
02200	REQUIRE UNSTACK_DELIMITERS;